Modifier la lumière,contraste ,couleur

**Montor** · 14/04/2010, 22h33

Modifier la lumière,contraste ,couleur d'une image et bel est bien d'autre opérations...

Unit1.pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
unit Unit1;
{Montor 12/04/2010}
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, StdCtrls;
 
type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    Button1: TButton;
    Panel2: TPanel;
    ScrollBox1: TScrollBox;
    Splitter1: TSplitter;
    ScrollBox2: TScrollBox;
    mView: TImage;
    ZoomBar: TTrackBar;
    Timer1: TTimer;
    Panel3: TPanel;
    Image: TImage;
    PixelGroup: TRadioGroup;
    HalftoneState: TCheckBox;
    Panel4: TPanel;
    Label1: TLabel;
    Label4: TLabel;
    Label3: TLabel;
    Label5: TLabel;
    Label2: TLabel;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    TrackBar3: TTrackBar;
    TrackBar4: TTrackBar;
    TrackBar5: TTrackBar;
    BReset: TButton;
    InvCh: TCheckBox;
    ZoomLabel: TLabel;
    BSave: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TrackBarsChange(Sender: TObject);
    procedure BResetClick(Sender: TObject);
    procedure xMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure xMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure xMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Timer(Sender: TObject);
    procedure PixelGroupClick(Sender: TObject);
    procedure HalftoneStateClick(Sender: TObject);
    procedure ZoomBarChange(Sender: TObject);
    procedure BSaveClick(Sender: TObject);
  private
    FView    :TBitmap;
    FBitmap  :TBitmap;
    FX,FY    :integer;
    FSelRect :TRect;
    FSelected:Boolean;
    FDC      :HDC;
    FAni     :TWincontrol;
    FLimits  :TRect;
    procedure xPaint();
    procedure AniRect;
    procedure RemoveRect;
    procedure SL(var C: integer; R: TRect);
    function AJustRect(const R:TRect;ALimit:boolean=true): TRect;
    function GetZoom():Single;
    procedure CopySelec();
 
   // procedure ViewResize();
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
uses jpeg;
   var ioo:integer;
const NoSelec:TRect=(Left:-1;Top:-1;Right:-1;Bottom:-1);
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
var
  S :string;
begin
  ScrollBox1.Enabled :=false;
  try
      if not PromptForFilename(S,GraphicFilter(TGraphic),'','Ouvrir','')then
         Exit;
 
      FView.Assign(nil);
      FBitmap.Assign(nil);
      with TPicture.Create do
      try
        LoadFromFile(S);
        FBitmap.PixelFormat :=pf24Bit;
        FBitmap.Width := Graphic.Width;
        FBitmap.Height:= Graphic.Height;
        FBitmap.Canvas.Draw(0,0,Graphic);
      finally
        Free();
      end;
      Application.ProcessMessages;
      FLimits   :=Rect(0,0,Image.Width-1,Image.Height-1);
 
      FSelected :=true;
      FSelRect  := FLimits;
      Timer1.Enabled :=true;
      PixelGroupClick(nil);
  finally
     ScrollBox1.Enabled :=true;
  end;
  ScrollBox1.Invalidate;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
   FBitmap  := Image.Picture.Bitmap;
   FView    := mView.Picture.Bitmap;
   FSelRect := NoSelec;
   FAni     := Panel3;
   FDC      := GetDc(FAni.Handle);
end;
 
procedure TForm1.TrackBarsChange(Sender: TObject);
begin
    xPaint();
end;
 
procedure TForm1.xPaint();
var
   Aj:TColorAdjustment ;
begin
  if HalftoneState.Checked then
  begin
    SetStretchBltMode(FView.Canvas.Handle,HALFTONE);
    GetColorAdjustment(FView.Canvas.Handle,Aj);
 
    Aj.caContrast     := TrackBar1.Position;
    Aj.caBrightness   := TrackBar2.Position;
    Aj.caRedGreenTint := TrackBar3.Position * 10;
    Aj.caColorfulness := TrackBar4.Position * 10;
    Aj.caRedGamma     := TrackBar5.Position * 100;
    Aj.caGreenGamma   := Aj.caRedGamma;
    Aj.caBlueGamma    := Aj.caRedGamma;
 
    if InvCh.Checked then
       Aj.caFlags :=  CA_NEGATIVE;
    SetColorAdjustment(FView.Canvas.Handle,Aj);
  end;
 
  with FView.Canvas do
    CopyRect(ClipRect,FBitmap.Canvas,FSelRect);
 
end;
 
procedure TForm1.ZoomBarChange(Sender: TObject);
begin
   ZoomBar.OnChange :=nil;
   try
      Application.ProcessMessages();
      CopySelec();
      xPaint();
   finally
     ZoomBar.OnChange :=ZoomBarChange;
   end;
end;
 
function TForm1.GetZoom(): Single;
begin
  result:= (ZoomBar.Position *4)/ZoomBar.Max;
end;
 
procedure TForm1.CopySelec();
var
R:Single;
begin
 if FSelected then
 with FSelRect do
 begin
   R :=  GetZoom();
   ZoomLabel.Caption:=Format('Taille %0.0f%%',[R*100]);
   FView.Width := Round((Right  - Left)* R);
   FView.Height:= Round((Bottom - Top) * R);
  end;
end;
 
procedure TForm1.PixelGroupClick(Sender: TObject);
var
 Pf:TPixelFormat;
begin
   case PixelGroup.ItemIndex of
        1: Pf :=pf8bit;
        2: Pf :=pf4bit;
        3: Pf :=pf1bit;
      else
           Pf :=pf24bit;
   end;
 
   if FView.PixelFormat = Pf then Exit;
 
   FView.Assign(nil);
   FView.PixelFormat:=Pf;
   CopySelec();
 
   xPaint();
end;
 
procedure TForm1.BResetClick(Sender: TObject);
begin
   TrackBar1.Position:= 0;
   TrackBar2.Position:= 0;
   TrackBar3.Position:= 0;
   TrackBar4.Position:= 0;
   TrackBar5.Position:= 100;
   InvCh.Checked :=false;
end;
 
procedure TForm1.HalftoneStateClick(Sender: TObject);
begin
   if Panel4.Visible = HalftoneState.Checked then
      Exit;
 
   Panel4.Visible := HalftoneState.Checked;
   xPaint();
end;
 
procedure TForm1.BSaveClick(Sender: TObject);
var
S:string;
begin
  if not PromptForFilename(S,'Image bmp|*.bmp','.bmp','Enregister','',true)then
         Exit;
  FView.SaveToFile(S);
end;
 
{Original source http://www.efg2.com/}
 
function TForm1.AJustRect(const R:TRect;ALimit:boolean): TRect;
begin
  with R do
  begin
        Result :=R;
        if  Left > Right then
        begin
           Result.Right := Left;
           Result.Left  := Right;
        end;
 
        if Top > Bottom then
        begin
           Result.Bottom := Top;
           Result.Top    := Bottom;
        end;
  end;
 
  if ALimit then
  with Result do
  begin
    if  Left   < FLimits.Left    then  Left:=FLimits.Left;
    if  Top    < FLimits.Top     then  Top :=FLimits.Top;
    if  Right  > FLimits.Right   then  Right:=FLimits.Right;
    if  Bottom > FLimits.Bottom  then  Bottom :=FLimits.Bottom;
  end;
end;
 
procedure TForm1.RemoveRect;
var
  R : TRect;
begin
  R := AJustRect(FSelRect);
  InflateRect(R,1,1);
  InvalidateRect(FAni.Handle,@R,True);
  InflateRect(R,-2,-2);
  ValidateRect(FAni.Handle,@R);
 
  UpdateWindow(FAni.Handle);
end;
 
procedure TForm1.Timer(Sender: TObject);
begin
 inc(ioo,2);
 AniRect();
end;
 
procedure TForm1.xMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if not PtinRect(FSelRect,Point(X,Y))then
 begin
     RemoveRect;
     FSelRect :=Rect(X,Y,X,Y);
     Timer1.Enabled :=False;
     FSelected :=false;
 end;
 FX:=X;
 FY:=Y;
end;
 
procedure TForm1.xMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 
  if not( ssLeft in Shift) then Exit;
 
  RemoveRect;
  if PtinRect(FSelRect,Point(X,Y)) and FSelected then
  begin
    OffsetRect(FSelRect,(X-FX),(Y-FY));
  end else begin
    FSelRect.Right  := X;
    FSelRect.Bottom := Y;
  end ;
 
  AniRect();
  FX:=X;
  FY:=Y;
end;
 
procedure TForm1.xMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
 W,H:integer;
begin
 FSelRect:=AJustRect(FSelRect);
 with AJustRect(FSelRect) do
 begin
    W:=Right  - Left ;
    H:=Bottom - Top;
 end;
 
 if (W > 0) and (H > 0) then
 begin
   Timer1.Enabled :=true;
   FSelected   :=true;
   CopySelec();
 end else begin
   Timer1.Enabled :=false;
   FSelected   :=false;
 end; 
 FAni.Invalidate();
 xPaint();
 
end;
 
procedure TForm1.SL(var C:integer;R:TRect);
var
  I,PR:integer;
  function NextColor(var AP:integer):TColor;
  begin
    if (AP and 7) < 4 then
      result:= clYellow
    else
      result:= clBlack;
     inc(AP);
  end;
 
begin
 
  PR := C;
      R:= AJustRect(R);
  for I:= R.Left to R.Right do
    Windows.SetPixelV(FDC,I,R.Top, NextColor(PR));
 
 
  for I:= R.Top to R.Bottom do
    Windows.SetPixelV(FDC,R.Right,I, NextColor(PR));
 
 
  for I:= R.Right downto R.Left do
    Windows.SetPixelV(FDC,I,R.Bottom, NextColor(PR));
 
 
  for I:= R.Bottom downto R.Top do
    Windows.SetPixelV(FDC,R.Left ,I, NextColor(PR));
end;
 
procedure TForm1.AniRect();
begin
  SL(ioo,FSelRect)
end;
 
end.

Unit1.dfm

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
object Form1: TForm1
  Left = 0
  Top = 0
  Width = 544
  Height = 455
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Splitter1: TSplitter
    Left = 241
    Top = 33
    Width = 5
    Height = 229
    Beveled = True
  end
  object StatusBar1: TStatusBar
    Left = 0
    Top = 400
    Width = 536
    Height = 21
    Panels = <>
  end
  object Panel1: TPanel
    Left = 0
    Top = 262
    Width = 536
    Height = 138
    Align = alBottom
    TabOrder = 1
    object Button1: TButton
      Left = 328
      Top = 80
      Width = 76
      Height = 25
      Caption = 'Image'
      TabOrder = 0
      OnClick = Button1Click
    end
    object PixelGroup: TRadioGroup
      Left = 416
      Top = 16
      Width = 73
      Height = 105
      Caption = 'Pixelformat'
      ItemIndex = 0
      Items.Strings = (
        '24bit'
        '  8bit'
        '  4bit'
        '  1bit')
      TabOrder = 1
      OnClick = PixelGroupClick
    end
    object HalftoneState: TCheckBox
      Left = 328
      Top = 16
      Width = 57
      Height = 17
      Caption = 'Halftone'
      Checked = True
      State = cbChecked
      TabOrder = 2
      OnClick = HalftoneStateClick
    end
    object Panel4: TPanel
      Left = 1
      Top = 1
      Width = 321
      Height = 136
      Align = alLeft
      TabOrder = 3
      object Label1: TLabel
        Left = 16
        Top = 13
        Width = 45
        Height = 13
        Caption = 'Contraste'
      end
      object Label4: TLabel
        Left = 16
        Top = 104
        Width = 36
        Height = 13
        Caption = 'Gamma'
      end
      object Label3: TLabel
        Left = 16
        Top = 81
        Width = 36
        Height = 13
        Caption = 'Couleur'
      end
      object Label5: TLabel
        Left = 16
        Top = 58
        Width = 30
        Height = 13
        Caption = 'Teinte'
      end
      object Label2: TLabel
        Left = 16
        Top = 37
        Width = 37
        Height = 13
        Caption = 'Lumière'
      end
      object TrackBar1: TTrackBar
        Left = 72
        Top = 5
        Width = 150
        Height = 20
        Max = 100
        Min = -100
        TabOrder = 0
        ThumbLength = 10
        TickMarks = tmTopLeft
        TickStyle = tsManual
        OnChange = TrackBarsChange
      end
      object TrackBar2: TTrackBar
        Left = 72
        Top = 29
        Width = 150
        Height = 20
        Max = 100
        Min = -100
        TabOrder = 1
        ThumbLength = 10
        TickMarks = tmTopLeft
        TickStyle = tsManual
        OnChange = TrackBarsChange
      end
      object TrackBar3: TTrackBar
        Left = 72
        Top = 50
        Width = 150
        Height = 20
        Min = -10
        TabOrder = 2
        ThumbLength = 10
        TickMarks = tmTopLeft
        TickStyle = tsManual
        OnChange = TrackBarsChange
      end
      object TrackBar4: TTrackBar
        Left = 72
        Top = 72
        Width = 150
        Height = 20
        Min = -10
        TabOrder = 3
        ThumbLength = 10
        TickMarks = tmTopLeft
        TickStyle = tsManual
        OnChange = TrackBarsChange
      end
      object TrackBar5: TTrackBar
        Left = 72
        Top = 95
        Width = 150
        Height = 20
        Max = 650
        Min = 25
        Position = 100
        TabOrder = 4
        ThumbLength = 10
        TickMarks = tmTopLeft
        TickStyle = tsManual
        OnChange = TrackBarsChange
      end
      object BReset: TButton
        Left = 238
        Top = 48
        Width = 75
        Height = 65
        Caption = 'Reset'
        TabOrder = 5
        OnClick = BResetClick
      end
      object InvCh: TCheckBox
        Left = 240
        Top = 16
        Width = 65
        Height = 17
        Caption = 'Inversé'
        TabOrder = 6
        OnClick = TrackBarsChange
      end
    end
  end
  object Panel2: TPanel
    Left = 0
    Top = 0
    Width = 536
    Height = 33
    Align = alTop
    TabOrder = 0
    object ZoomLabel: TLabel
      Left = 216
      Top = 8
      Width = 25
      Height = 13
      Caption = 'Taille'
    end
    object ZoomBar: TTrackBar
      Left = 280
      Top = 8
      Width = 150
      Height = 32
      Max = 40
      Min = 1
      Position = 10
      TabOrder = 0
      ThumbLength = 10
      TickStyle = tsNone
      OnChange = ZoomBarChange
    end
    object BSave: TButton
      Left = 440
      Top = 2
      Width = 75
      Height = 24
      Caption = 'Enregistrer'
      TabOrder = 1
      OnClick = BSaveClick
    end
  end
  object ScrollBox1: TScrollBox
    Left = 0
    Top = 33
    Width = 241
    Height = 229
    HorzScrollBar.Increment = 21
    VertScrollBar.Increment = 20
    VertScrollBar.Tracking = True
    Align = alLeft
    BorderStyle = bsNone
    Color = clGray
    ParentColor = False
    TabOrder = 3
    object Panel3: TPanel
      Left = 16
      Top = 8
      Width = 153
      Height = 105
      Cursor = crCross
      AutoSize = True
      BevelOuter = bvNone
      TabOrder = 0
      OnMouseDown = xMouseDown
      OnMouseMove = xMouseMove
      OnMouseUp = xMouseUp
      object Image: TImage
        Left = 0
        Top = 0
        Width = 153
        Height = 105
        AutoSize = True
        Enabled = False
      end
    end
  end
  object ScrollBox2: TScrollBox
    Left = 246
    Top = 33
    Width = 290
    Height = 229
    VertScrollBar.Tracking = True
    Align = alClient
    BorderStyle = bsNone
    Color = clGray
    ParentColor = False
    TabOrder = 4
    object mView: TImage
      Left = 8
      Top = 8
      Width = 105
      Height = 105
      AutoSize = True
    end
  end
  object Timer1: TTimer
    Enabled = False
    Interval = 100
    OnTimer = Timer
    Left = 38
    Top = 169
  end
end

**Rayek** · 15/04/2010, 09h28

Il manque fortement de commentaires dans le code, c'est largement plus ludique avec que sans et ca permet de comprendre rapidement à quoi sert telle ou telle fonction.
Et il serait bien de renommer certain composant (Trackbar1 pas terrible pour savoir quel est son action si on n'a pas le dfm en visuel)

**Dr.Who** · 15/04/2010, 20h20

et bonjour la dépendance des fonctions à la classe ... un code exemple doit toujours être réutilisable...

pourquoi avoir baclé ton travail ... tu fais mieux d'habitude.

**Montor** · 15/04/2010, 23h22

ok pour les commentaires je pensais que le code est suffisamment clair

@Who
Tout la démonstration est base sur des fonction simplistes GetColorAdjustment SetColorAdjustment tu pense qu une classe est vraiment nécessaire ?

**Dr.Who** · 15/04/2010, 23h33

c'est tout ?

une classe non, mais expliquer leurs fonctionnement en dehors de l'exemple aurai été plus judicieux je pense...

et crois moi ... un code n'est jamais suffisamment parlant! commenter la partie la plus importante n'est jamais superflus.

je pense que pour présenter 2 fonction un tout petit tuto accompagné d'un code exemple serai mieux ? tu ne crois pas ?

Modifier la lumière,contraste ,couleur

Contribuez Delphi

Discussions similaires

Partager

Partager