home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 5 / MasteringVisualBasic5.iso / olympus / ik32_15t / delphi2.shr / UCOLREP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-01  |  4.8 KB  |  164 lines
  1. { Project ColRep.DPR Delphi 2.0 Demos
  2.  
  3.   Description:- ColRep.Dpr Project:-
  4.  
  5.    Demonstrates the use of:
  6.  
  7.    1) 'GetColor'
  8.    2) 'GetPalIndex'
  9.    3) 'SetPalIndex'
  10.    4) 'ColorReplace'
  11.    5) 'RGB'
  12.  
  13.    Date of Origin: 15/04/96
  14.    Original Author: Andrew Hutchison
  15.    Modification History:
  16.  
  17.    Date        Person                            Change
  18.    ----------------------------------------------------
  19.    15/04/96    A Hutchison                       Created
  20.  
  21.    (c) Copyright Media Architects Inc. 1996.
  22.    All rights reserved.   No part of this program may be
  23.    photocopied, reproduced, translated to another programming
  24.    language or transported to any computer system without the
  25.    prior written consent of Media Architects Inc.}
  26.  
  27. unit UColRep;
  28.  
  29. interface
  30.  
  31. uses
  32.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  33.   StdCtrls, ExtCtrls, Buttons, Spin, OleCtrls, ImageKnife32, Menus;
  34.  
  35. type
  36.   TForm1 = class(TForm)
  37.     Bevel1: TBevel;
  38.     Picbuf1: TPicbuf;
  39.     GroupBox1: TGroupBox;
  40.     RedVal: TSpinEdit;
  41.     GreenVal: TSpinEdit;
  42.     BlueVal: TSpinEdit;
  43.     Color: TSpeedButton;
  44.     Label1: TLabel;
  45.     Label2: TLabel;
  46.     Label3: TLabel;
  47.     MainMenu1: TMainMenu;
  48.     File1: TMenuItem;
  49.     LoadImage: TMenuItem;
  50.     N1: TMenuItem;
  51.     Exit: TMenuItem;
  52.     OpenDialog: TOpenDialog;
  53.     Picbuf2: TPicbuf;
  54.     procedure ColorClick(Sender: TObject);
  55.     procedure LoadImageClick(Sender: TObject);
  56.     procedure Picbuf1MouseDown(Sender: TObject; Button: TMouseButton;
  57.       Shift: TShiftState; X, Y: Integer);
  58.     procedure ExitClick(Sender: TObject);
  59.     procedure FormCreate(Sender: TObject);
  60.     procedure FormActivate(Sender: TObject);
  61.   private
  62.     { Private declarations }
  63.   public
  64.     { Public declarations }
  65.   end;
  66.  
  67. var
  68.   Form1: TForm1;
  69.  
  70. implementation
  71.  
  72. {$R *.DFM}
  73.  
  74. {-------------------------------------------------------------------------------}
  75. {Set the color of the second PicBuf to the values of the SpinEdit boxes
  76.  
  77. Note:- The advantage of using these 'SpinEdit' boxes, is that you can define a
  78. lower limit and upper limit for the returned value. In otherwords it won't let
  79. you enter 300 for example which is not a valid RGB colour.  Is also returns an
  80. integer number by default so no conversions are required}
  81. procedure TForm1.ColorClick(Sender: TObject);
  82. begin
  83.   PicBuf2.BackColor := RGB(RedVal.Value,GreenVal.Value,BlueVal.Value);               {Set Color}
  84. end;
  85.  
  86. {-------------------------------------------------------------------------------}
  87. {Load an Image using its extension.}
  88. procedure TForm1.LoadImageClick(Sender: TObject);
  89. begin
  90. {Execute Dialog Box}
  91. if OpenDialog.execute then
  92.  begin
  93.  {Set FileName}
  94.  Picbuf1.FileName:=OpenDialog.Filename;
  95.  {Call Load Method}
  96.  Picbuf1.Load;
  97.  end;
  98. end;
  99.  
  100. {-------------------------------------------------------------------------------}
  101. {When you click on an Image, the color at the mouse location is stored.  That
  102. color is then replaced with the color that is displayed in the 'Shape Object'.
  103. This code replaces only colors that match 100% the picked color.}
  104. procedure TForm1.Picbuf1MouseDown(Sender: TObject; Button: TMouseButton;
  105. Shift: TShiftState; X, Y: Integer);
  106. Var
  107. Xpos,Ypos:Integer;
  108. ChangeColor,SelectedColor:LongInt;
  109. begin
  110. {Set trap to avoid non valid points}
  111. try
  112. {Get Mouse Down Location - in pixels - Delphi Default}
  113. XPos := Picbuf1.ScreenToImageX(X);
  114. YPos := Picbuf1.ScreenToImageY(Y);
  115. {Get user selected color - Edit Box Values}
  116. ChangeColor := RGB(RedVal.Value,GreenVal.Value,BlueVal.Value);
  117. {24 Bit Images}
  118. if Picbuf1.ColorDepth = 24 then
  119.  begin
  120.  {Get Color at Mouse Down Location}
  121.  SelectedColor := Picbuf1.GetColor(XPos,YPos);                      {Call Method}
  122.  {Replace Color}
  123.  Picbuf1.ColorReplace(SelectedColor,SelectedColor,0, ChangeColor);  {Call Method}
  124. end
  125.  else{Images with Palettes}
  126.  begin
  127.  {Get Color at Palette Location}
  128.  SelectedColor := Picbuf1.GetPalIndex(XPos, YPos);                  {Call Method}
  129.  {Set Color a Palette Location}
  130.  Picbuf1.SetPalColor(SelectedColor, ChangeColor);                   {Call Method}
  131.  end;
  132. {Error Trap for Non - Valid Locations}
  133. except
  134. MessageDLG('Non Valid Point or Non Valid Image - OK to Continue.', mtConfirmation,
  135. [mbOK], 0);
  136. end;
  137. end;
  138.  
  139. {-------------------------------------------------------------------------------}
  140. {Exit Application}
  141. procedure TForm1.ExitClick(Sender: TObject);
  142. begin
  143. Halt;
  144. end;
  145.  
  146. {-------------------------------------------------------------------------------}
  147. {Defaults}
  148. procedure TForm1.FormCreate(Sender: TObject);
  149. begin
  150. Application.HintPause :=10;
  151. Application.HintColor:=clAqua;
  152. end;
  153.  
  154. procedure TForm1.FormActivate(Sender: TObject);
  155. begin
  156.  Picbuf1.FileName:= '..\images\bambi1.bmp';
  157.  Picbuf1.Load;
  158.  PicBuf2.BackColor := RGB(RedVal.Value,GreenVal.Value,BlueVal.Value);               {Set Color}
  159. end;
  160.  
  161.  
  162.  
  163. end.
  164.